unit mu_parser;

interface

uses classes,sysutils,comctrls,windows,rxstrutils;

var
  gl_maildir,gl_hostname:string;
  gl_baseurl,gl_mesdir:string;
  gl_retrid:integer;
  node_priv,node_comms,node_forums:TTreenode;
  gl_mtype:integer;
  gl_comname:string;
  gl_repid,gl_comid:integer;
  glp_info:string;
  gl_dostring:boolean;
  gc_login,gc_password,gc_plogin,gc_ppassword,gc_hostname:string;
  gm_to:string;
  glr_to,glr_subj:string;
  gl_favlist:TStrings;


function getToken(s:string;num:integer;ras:string):string;
function getToknum(s:string;ras:char):integer;
function getFileDate(name:string):TdateTime;

Type

Tchat=class

public
 count:longint;
 nums:array[1..1000] of longint;
 lastnum:longint;
 body:Tstrings;
 filename:string;
 constructor create;
 destructor destroy; override;
 procedure loadfromfile(fn:string);
 procedure appendfromfile(fn:string);
 function getLine(num:integer):string;
end;


Tsitecomm=class
private
       Fst:TStrings;
       findex,fsize:array[0..1000] of longint;
       fcount:longint;
       fempty:boolean;
       fname:string;
public
      destructor Destroy; override;
      constructor Create;
      property count:integer read fcount;
      property isEmpty:boolean read fempty;
      procedure loadfromfile(id:integer);
      procedure getMesbyNum(id:integer;var sl:Tstrings);
      function getAuthor(id:integer):string;
      function getDate(id:integer):string;
      function getTime(id:integer):string;
      procedure getMesbyDate(date:string;var sl:TStrings);
      procedure setName(name:string);
      property name:string read fname write setName;
      procedure getCommsbyAutor(name:string; var sl:TStrings);
end;

TPlayerList=class(TObject)
private
       flogins:TStrings;
       fnames:Tstrings;
       ffrom:Tstrings;
       fcount:longint;
       index:array[0..2000] of integer;
public
      constructor create;
      destructor Destroy; override;
      procedure loadfromfile(name:string;sorted:boolean);
      property count:longint read fcount;
      function getNumLogin(login:string):longint;
      function getName(num:integer):string;
      function getFrom(num:integer):string;
      function getLogin(num:integer):string;
      procedure sort(st:Tstrings);
      procedure sortbyname;
      procedure sortbylogin;
      procedure sortbyfrom;
      function getfindnum(key:string):integer;
end;

TGameList=class(TObject)
private
       fst:TStrings;
       fcount:integer;
       fid,findex,fsize:array[0..1000] of longint;
public
      constructor create;
      destructor destroy; override;
      procedure loadfromfile(name:string);
      property count:integer read fcount;
      function getinfobynum(id,num:integer):string;
      function getitemcount(id:integer):integer;
      function getfieldnum(id,num,num1:integer):string;
      function getRaceLogin(id:integer;rac:integer):string;
      function getlogingames(login:string):string;
      function getgameloginnum(id:integer;login:string):integer;
end;

implementation

constructor tchat.create;
begin
 body:=TStringlist.create;
 lastnum:=0;
 fillchar(nums,sizeof(nums),0);
 count:=0;
end;

destructor tchat.destroy;
begin
 body.free;
end;

function tchat.getLine;
var
 p,i:integer;
 s:string;
begin
 result:='';
 if num>=body.count then exit;
 s:=body[num];
 p:=pos(' ',s);
 if p=0 then exit;
 delete(s,1,p);
 result:=s;
end;

procedure Tchat.loadfromfile;
var
 i:integer;
 s,s1:string;
begin
 body.clear;
 count:=0;lastnum:=0;
 if not fileexists(fn) then exit;
 self.filename:=fn;
 body.LoadFromFile(fn);
 body.Insert(0,'<LINK href="chat.css" rel="stylesheet" type="text/css"><base href="http://militarizm.tora.ru"><table cellspacing=0 cellpadding=0 border=0 width=100% height=100%>');
 body.SaveToFile(fn);
 if body.count>0 then begin
  s:=body[1];
  s:=gettoken(s,1,':');
  if s<>'' then lastnum:=strtoint(s);
  for i:=1 to body.count-1 do begin
   s:=gettoken(body[i],1,':');
   s1:=body[i];
   if s<>'' then begin
    delete(s1,1,length(s)+1);
    body[i]:=s1;
   end;
  end;
  body.SaveToFile(fn);
 end;
 body.add('</table>');
end;

procedure Tchat.appendfromfile;
var
 i:integer;
 s,s1:string;
 sl:TStrings;
begin
 if not fileexists(fn) then exit;
 sl:=Tstringlist.create;
 sl.loadfromfile(fn);
 for i:=sl.count-1 downto 0 do begin
  s:=gettoken(sl[i],1,':');
  s1:=sl[i];
  if s<>'' then begin
   lastnum:=strtoint(s);
   delete(s1,1,length(s)+1);
  end;
  body.Insert(1,s1);
 end;
 body.SaveToFile(filename);
// self.filename:=fn;
 sl.free;
{ if body.count>0 then begin
  s:=body[1];
  s:=gettoken(s,1,':');
  if s<>'' then lastnum:=strtoint(s);
 end;}
end;

function getfiledate;
var
 fh:longint;
begin
  result:=strtodate('22.12.00');
  if not fileexists(name) then exit;
  fh:=CreateFile(pchar(name),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  result:=FileDateToDateTime(filegetdate(fh));
  closehandle(fh);
end;

function tgamelist.getlogingames;
var
 i,j:integer;
 s:string;
begin
 result:='';
 for i:=0 to count do begin
  for j:=1 to getitemcount(fid[i]) do begin
   s:=getfieldnum(fid[i],j,2);
   if s=login then result:=result+inttostr(fid[i]+1)+';';
  end;
 end;
end;

function tgamelist.getgameloginnum;
var
 i,j:integer;
 s:string;
begin
  result:=0;
  for j:=1 to getitemcount(id) do begin
   s:=getfieldnum(id,j,2);
   if s=login then begin
    result:=j;
    exit;
   end;
  end;
end;

function tgamelist.getRaceLogin;
var
 i:integer;
 s:string;
begin
 result:='';
 for i:=1 to getitemcount(id) do begin
  s:=getfieldnum(id,i,2);
  if getfieldnum(id,i,1)=inttostr(rac) then begin
   result:=s;
   exit;
  end;
 end;
end;

function tgamelist.getitemcount;
begin
 result:=fsize[id]-findex[id]-1;
end;

function tgamelist.getfieldnum;
var
 s:string;
begin
 s:=fst[findex[id]+1+num];
 s:=gettoken(s,num1,';');
 result:=s;
end;

function tgamelist.getinfobynum;
var
 s:String;
begin
 result:='';
 if id>=fcount then exit;
 s:=fst[findex[id]+1];
 result:=getToken(s,num,';');
end;

procedure TgameList.loadfromfile;
var
 k,i:integer;
 s:string;
begin
 fillchar(fid,sizeof(fid),0);
 findex:=fid;fsize:=fid;fcount:=0;
 if not fileexists(name) then exit;
 fst.loadfromfile(name);
 k:=0;
 for i:=0 to fst.count-1 do begin
  s:=fst[i];
  if (s[1]='@') then begin
   delete(s,1,2);
   delete(s,length(s)-1,2);
   fid[k]:=strtoint(s);
   findex[k]:=i;
   if k>0 then fsize[k-1]:=findex[k]-1;
   k:=k+1;
  end;
 end;
 fsize[k-1]:=fst.count-1;
 fcount:=k;
end;

constructor tgamelist.create;
begin
 inherited create;
 fst:=TStringlist.create;
end;

destructor tgamelist.destroy;
begin
 inherited  destroy;
 fst.free;
end;

procedure Tplayerlist.sortbyname;
begin
 sort(fnames);
end;
procedure Tplayerlist.sortbylogin;
begin
 sort(flogins);
end;

procedure Tplayerlist.sortbyfrom;
begin
 sort(ffrom);
end;

function TPlayerList.getLogin;
begin
 result:='';
 if (num>fcount) or (num<0) then exit;
 result:=flogins[index[num]];
end;

function TPlayerList.getName;
begin
 result:='';
 if (num>fcount) or (num<0) then exit;
 result:=fnames[index[num]];
end;

function TPlayerList.getFrom;
begin
 result:='';
 if (num>fcount) or (num<0) then exit;
 result:=ffrom[index[num]];
end;

function TplayerList.getNumLogin;
var
 a,i:integer;
begin
 result:=-1;
 if count=0 then exit;
 for i:=0 to count-1 do if flogins[index[i]]=login then begin
  result:=i;
  break;
 end;
end;

procedure Tplayerlist.sort;
var
 k,i:integer;
 s:string;
 flag:boolean;
begin
 for i:=0 to fcount-1 do index[i]:=i;
 repeat
 flag:=true;
 for i:=0 to fcount-2 do begin
  if st[index[i]]>st[index[i+1]] then begin
   k:=index[i];
   index[i]:=index[i+1];
   index[i+1]:=k;
   flag:=false;
  end;
 end;
 until flag=true;
end;

function tplayerlist.getfindnum;
var
 i,k:integer;
 s:string;
 flag:boolean;
begin
 result:=-1;
 flag:=false;
 for i:=0 to count-1 do begin
  if pos(ansiuppercase(key),ansiuppercase(flogins[index[i]]))<>0 then flag:=true else
   if pos(ansiuppercase(key),ansiuppercase(fnames[index[i]]))<>0 then flag:=true else
    if pos(ansiuppercase(key),ansiuppercase(ffrom[index[i]]))<>0 then flag:=true else
  if flag=true then begin
   result:=i;
   exit;
  end;
 end;
end;



procedure TplayerList.loadfromfile;
var
 i:integer;
 st:Tstrings;
 s:string;

begin
 flogins.add('mhost');
 fnames.add('HOST');
 ffrom.add('militarizm.tora.ru');
 index[0]:=0;
 fcount:=1;
 if not fileexists(name) then exit;
 st:=Tstringlist.create;
 st.loadfromfile(name);
 for i:=0 to st.count-1 do begin
  s:=st[i];
  flogins.Add(getToken(s,1,';'));
  fnames.add(gettoken(s,2,';'));
  ffrom.add(gettoken(s,3,';'));
  index[i+1]:=i+1;
 end;
 fcount:=fcount+st.Count;
 sort(fnames);
 st.free;
end;


constructor TplayerList.create;
begin
 inherited create;
 flogins:=Tstringlist.create;
 fnames:=TStringlist.create;
 ffrom:=Tstringlist.create;
 fcount:=0;
end;

destructor TplayerList.Destroy;
begin
 inherited destroy;
 flogins.free;
 fnames.free;
 ffrom.free;
end;


procedure tsitecomm.getCommsbyAutor;
var
 i:integer;
 s:string;
begin
 for i:=0 to fcount-1 do begin
  s:=getauthor(i);
  if s=name then begin
   getmesbynum(i,sl);
  end;
 end;
end;

procedure Tsitecomm.setName;
begin
 fname:=name;
end;

function gettoknum;
begin
 result:=wordcount(s,[ras]);
end;

function getToken(s:string;num:integer;ras:string):string;
var p1,p2,i:integer;
begin
 p1:=0;
 result:='';
 repeat
  p2:=pos(ras[1],s);
  if p2=0 then break;
  num:=num-1;
  if num=0 then result:=copy(s,p1+1,(p2-p1-1));
  p1:=p2;
  s[p2]:='~';
 until num=0;
end;

function TSiteComm.getTime;
begin
 result:='';
 if isEmpty or (id>fcount) then exit;
 result:=fst[findex[id]+1];
 delete(result,1,1);
 result:=trim(getToken(result,2,'/'));
end;

function TSiteComm.getDate;
begin
 result:='';
 if isEmpty or (id>fcount) then exit;
 result:=fst[findex[id]+1];
 delete(result,1,1);
 result:=trim(getToken(result,1,'/'));
end;

function TSiteComm.getAuthor;
var
 s:string;
begin
 result:='';
 if (isEmpty) or (id>fcount) then exit;
 result:=fst[findex[id]];
 delete(result,1,1);
 result:=trim(result);
end;


procedure TSiteComm.getMesbyNum;
var
 i:integer;
begin
 if isEmpty or (id>fcount) then exit;
 sl.BeginUpdate;
 for i:=findex[id] to findex[id]+fsize[id] do sl.add(fst[i]);
 sl.EndUpdate;
end;

procedure TSiteComm.getMesbyDate;
var
 i:integer;
 sd:string;
begin
 sl.clear;
 if isEmpty then exit;
 for i:=0 to fcount-1 do begin
  if getDate(i)=date then getmesbynum(i,sl);
 end;
end;


procedure Tsitecomm.loadfromfile;
var
 i:longint;
 s,s1:string;
begin
 try   
 fempty:=true;
 fcount:=0;
 if fileexists(gl_mesdir+'gamecom'+inttostr(id)+'.txt') then begin
  fst:=TStringlist.create;
  fst.LoadFromFile(gl_mesdir+'gamecom'+inttostr(id)+'.txt');
  fempty:=false;
  fst.add('');
  for i:=0 to fst.count-2 do begin
   s:=fst[i];s1:=fst[i+1];
   if length(s)<1 then continue;
   if (s[1]='#') and (s1[1]='#') then begin
    findex[fcount]:=i;
    if fcount>0 then fsize[fcount-1]:=i-findex[fcount-1]-1;
    fcount:=fcount+1;
   end;
  end;
  fsize[fcount-1]:=(fst.count-1)-findex[fcount-1];
 end;
 except
  destroy;
  raise;
 end;
end;

destructor Tsitecomm.Destroy;
begin
 fst.free;
 inherited destroy;
end;

constructor Tsitecomm.Create;
begin
 inherited create;
 self.fst:=TStringlist.create;
end;
end.
